home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / AALIAS.FRM next >
Text File  |  1996-05-02  |  12KB  |  419 lines
  1. VERSION 4.00
  2. Begin VB.Form AntiAliasForm 
  3.    Caption         =   "Anti-Aliasing"
  4.    ClientHeight    =   4485
  5.    ClientLeft      =   1905
  6.    ClientTop       =   1275
  7.    ClientWidth     =   5835
  8.    DrawMode        =   14  'Copy Pen
  9.    Height          =   5175
  10.    Left            =   1845
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   299
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   389
  15.    Top             =   645
  16.    Width           =   5955
  17.    Begin VB.CheckBox ColorCheck 
  18.       Caption         =   "Color"
  19.       Height          =   255
  20.       Left            =   3000
  21.       TabIndex        =   9
  22.       Top             =   45
  23.       Value           =   1  'Checked
  24.       Width           =   735
  25.    End
  26.    Begin VB.CommandButton CmdGo 
  27.       Caption         =   "Go"
  28.       Default         =   -1  'True
  29.       Height          =   375
  30.       Left            =   3960
  31.       TabIndex        =   8
  32.       Top             =   0
  33.       Width           =   615
  34.    End
  35.    Begin VB.TextBox ScaleText 
  36.       Height          =   285
  37.       Left            =   2520
  38.       TabIndex        =   6
  39.       Text            =   "2"
  40.       Top             =   30
  41.       Width           =   375
  42.    End
  43.    Begin VB.PictureBox EnlargedPic 
  44.       AutoRedraw      =   -1  'True
  45.       BackColor       =   &H00C0C0C0&
  46.       ForeColor       =   &H00000000&
  47.       Height          =   3870
  48.       Left            =   1965
  49.       Picture         =   "AALIAS.frx":0000
  50.       ScaleHeight     =   254
  51.       ScaleMode       =   3  'Pixel
  52.       ScaleWidth      =   254
  53.       TabIndex        =   4
  54.       Top             =   600
  55.       Width           =   3870
  56.    End
  57.    Begin VB.PictureBox AntiAliasedPic 
  58.       AutoRedraw      =   -1  'True
  59.       BackColor       =   &H00C0C0C0&
  60.       ForeColor       =   &H00000000&
  61.       Height          =   1935
  62.       Left            =   0
  63.       Picture         =   "AALIAS.frx":0446
  64.       ScaleHeight     =   125
  65.       ScaleMode       =   3  'Pixel
  66.       ScaleWidth      =   125
  67.       TabIndex        =   2
  68.       Top             =   2520
  69.       Width           =   1935
  70.    End
  71.    Begin VB.PictureBox AliasedPic 
  72.       AutoRedraw      =   -1  'True
  73.       BackColor       =   &H00C0C0C0&
  74.       BeginProperty Font 
  75.          name            =   "Times New Roman"
  76.          charset         =   1
  77.          weight          =   700
  78.          size            =   15.75
  79.          underline       =   0   'False
  80.          italic          =   -1  'True
  81.          strikethrough   =   0   'False
  82.       EndProperty
  83.       ForeColor       =   &H00000000&
  84.       Height          =   1935
  85.       Left            =   0
  86.       Picture         =   "AALIAS.frx":088C
  87.       ScaleHeight     =   125
  88.       ScaleMode       =   3  'Pixel
  89.       ScaleWidth      =   125
  90.       TabIndex        =   0
  91.       Top             =   240
  92.       Width           =   1935
  93.    End
  94.    Begin VB.Label Label1 
  95.       Caption         =   "Scale"
  96.       Height          =   255
  97.       Index           =   3
  98.       Left            =   2040
  99.       TabIndex        =   7
  100.       Top             =   45
  101.       Width           =   495
  102.    End
  103.    Begin VB.Label Label1 
  104.       Caption         =   "Enlarged"
  105.       Height          =   255
  106.       Index           =   2
  107.       Left            =   1965
  108.       TabIndex        =   5
  109.       Top             =   360
  110.       Width           =   735
  111.    End
  112.    Begin VB.Label Label1 
  113.       Caption         =   "Anti-Aliased"
  114.       Height          =   255
  115.       Index           =   1
  116.       Left            =   0
  117.       TabIndex        =   3
  118.       Top             =   2280
  119.       Width           =   975
  120.    End
  121.    Begin VB.Label Label1 
  122.       Caption         =   "Aliased"
  123.       Height          =   255
  124.       Index           =   0
  125.       Left            =   0
  126.       TabIndex        =   1
  127.       Top             =   0
  128.       Width           =   615
  129.    End
  130.    Begin VB.Menu mnuFile 
  131.       Caption         =   "&File"
  132.       Begin VB.Menu mnuFileExit 
  133.          Caption         =   "E&xit"
  134.       End
  135.    End
  136. End
  137. Attribute VB_Name = "AntiAliasForm"
  138. Attribute VB_Creatable = False
  139. Attribute VB_Exposed = False
  140. Option Explicit
  141.  
  142. ' ************************************************
  143. ' Redraw the original stuff.
  144. ' ************************************************
  145. Private Sub ColorCheck_Click()
  146.     DrawIt AliasedPic
  147. End Sub
  148.  
  149.  
  150. ' ************************************************
  151. ' Draw stuff in color or black and white.
  152. ' ************************************************
  153. Sub DrawIt(pic As PictureBox)
  154.     If ColorCheck.Value = vbChecked Then
  155.         ColorDrawStuff pic
  156.     Else
  157.         BWDrawStuff pic
  158.     End If
  159. End Sub
  160.  
  161. ' ************************************************
  162. ' Anti-alias.
  163. ' ************************************************
  164. Sub CmdGo_Click()
  165. Dim S As Integer
  166.  
  167.     MousePointer = vbHourglass
  168.     
  169.     ' Redraw AliaedPic in case ColorCheck changed.
  170.     DrawIt AliasedPic
  171.     
  172.     ' Make EnlargedPic the correct size.
  173.     If Not IsNumeric(ScaleText.Text) Then _
  174.         ScaleText.Text = "2"
  175.     S = CInt(ScaleText.Text)
  176.     If S < 1 Then
  177.         ScaleText.Text = "2"
  178.         S = 2
  179.     End If
  180.     
  181.     EnlargedPic.Width = _
  182.         EnlargedPic.Width - _
  183.         EnlargedPic.ScaleWidth + _
  184.         S * AliasedPic.ScaleWidth
  185.     EnlargedPic.Height = _
  186.         EnlargedPic.Height - _
  187.         EnlargedPic.ScaleHeight + _
  188.         S * AliasedPic.ScaleHeight
  189.     
  190.     ' Make EnlargedPic use the right thicknesses.
  191.     EnlargedPic.DrawWidth = S * AliasedPic.DrawWidth
  192.     EnlargedPic.Font.Size = S * AliasedPic.Font.Size
  193.     
  194.     ' Draw the enlarged picture.
  195.     AntiAliasedPic.Cls
  196.     DrawIt EnlargedPic
  197.     DoEvents
  198.     
  199.     ' Shrink the enlarged picture.
  200.     ShrinkPicture EnlargedPic, AntiAliasedPic, S
  201.  
  202.     MousePointer = vbDefault
  203. End Sub
  204.  
  205. ' ************************************************
  206. ' Draw some stuff in black and white.
  207. ' ************************************************
  208. Sub BWDrawStuff(pic As PictureBox)
  209. Const PI = 3.14159
  210. Const MSG = "Smile!"
  211.  
  212. Dim x1 As Single
  213. Dim x2 As Single
  214. Dim x3 As Single
  215. Dim x4 As Single
  216. Dim x5 As Single
  217. Dim x6 As Single
  218. Dim x7 As Single
  219. Dim y1 As Single
  220. Dim y2 As Single
  221. Dim dy As Single
  222. Dim r1 As Single
  223. Dim r2 As Single
  224. Dim r3 As Single
  225. Dim r4 As Single
  226.  
  227.     x1 = pic.ScaleWidth * 0.4
  228.     x2 = pic.ScaleWidth * 0.27
  229.     x3 = pic.ScaleWidth * 0.53
  230.     x4 = pic.ScaleWidth * 0.29
  231.     x5 = pic.ScaleWidth * 0.55
  232.     x6 = pic.ScaleWidth * 0.8
  233.     x7 = pic.ScaleWidth * 1
  234.     y1 = pic.ScaleHeight * 0.4
  235.     y2 = pic.ScaleHeight * 0.25
  236.     r1 = pic.ScaleHeight * 0.35
  237.     r2 = pic.ScaleHeight * 0.25
  238.     r3 = pic.ScaleHeight * 0.05
  239.     r4 = pic.ScaleHeight * 0.0375
  240.     
  241.     pic.Cls
  242.     
  243.     pic.Circle (x1, y1), r1
  244.     pic.Circle (x1, y1), r2, , PI, 2 * PI
  245.     pic.Circle (x1, y1), r3
  246.     pic.Circle (x2, y2), r3
  247.     pic.Circle (x3, y2), r3
  248.     pic.FillStyle = vbFSSolid
  249.     pic.Circle (x4, y2), r4, , , , 1.5
  250.     pic.Circle (x5, y2), r4, , , , 1.5
  251.     pic.FillStyle = vbFSTransparent
  252.     
  253.     pic.CurrentX = x1 - pic.TextWidth(MSG) / 2
  254.     pic.CurrentY = (pic.ScaleHeight + y1 + r1 _
  255.         - pic.TextHeight(MSG)) / 2
  256.     pic.Print MSG
  257.     
  258.     dy = pic.ScaleHeight / 15
  259.     For y1 = dy / 2 To pic.ScaleHeight Step dy
  260.         pic.Line (x6, y1)-(x7, y1 * 2)
  261.     Next y1
  262. End Sub
  263.  
  264. ' ************************************************
  265. ' Draw some stuff to work with.
  266. ' ************************************************
  267. Sub ColorDrawStuff(pic As PictureBox)
  268. Const PI = 3.14159
  269. Const MSG = "Smile!"
  270.  
  271. Dim x1 As Single
  272. Dim x2 As Single
  273. Dim x3 As Single
  274. Dim x4 As Single
  275. Dim x5 As Single
  276. Dim x6 As Single
  277. Dim x7 As Single
  278. Dim y1 As Single
  279. Dim y2 As Single
  280. Dim dy As Single
  281. Dim r1 As Single
  282. Dim r2 As Single
  283. Dim r3 As Single
  284. Dim r4 As Single
  285.  
  286.     x1 = pic.ScaleWidth * 0.4
  287.     x2 = pic.ScaleWidth * 0.27
  288.     x3 = pic.ScaleWidth * 0.53
  289.     x4 = pic.ScaleWidth * 0.29
  290.     x5 = pic.ScaleWidth * 0.55
  291.     x6 = pic.ScaleWidth * 0.8
  292.     x7 = pic.ScaleWidth * 1
  293.     y1 = pic.ScaleHeight * 0.4
  294.     y2 = pic.ScaleHeight * 0.25
  295.     r1 = pic.ScaleHeight * 0.35
  296.     r2 = pic.ScaleHeight * 0.25
  297.     r3 = pic.ScaleHeight * 0.05
  298.     r4 = pic.ScaleHeight * 0.0375
  299.     
  300.     pic.Cls
  301.     
  302.     pic.FillStyle = vbFSSolid
  303.     pic.FillColor = vbYellow
  304.     pic.ForeColor = pic.FillColor
  305.     pic.Circle (x1, y1), r1
  306.     pic.FillColor = RGB(255, 153, 51)
  307.     pic.ForeColor = pic.FillColor
  308.     pic.Circle (x1, y1), r3
  309.     pic.FillColor = vbWhite
  310.     pic.ForeColor = vbBlack
  311.     pic.Circle (x2, y2), r3
  312.     pic.Circle (x3, y2), r3
  313.     pic.FillColor = vbBlack
  314.     pic.Circle (x4, y2), r4, , , , 1.5
  315.     pic.Circle (x5, y2), r4, , , , 1.5
  316.     pic.FillStyle = vbFSTransparent
  317.     pic.ForeColor = vbRed
  318.     pic.Circle (x1, y1), r2, , PI, 2 * PI
  319.     
  320.     pic.ForeColor = vbBlue
  321.     pic.CurrentX = x1 - pic.TextWidth(MSG) / 2
  322.     pic.CurrentY = (pic.ScaleHeight + y1 + r1 _
  323.         - pic.TextHeight(MSG)) / 2
  324.     pic.Print MSG
  325.     
  326.     pic.ForeColor = RGB(&H80, 0, &H80)
  327.     dy = pic.ScaleHeight / 15
  328.     For y1 = dy / 2 To pic.ScaleHeight Step dy
  329.         pic.Line (x6, y1)-(x7, y1 * 2)
  330.     Next y1
  331.  
  332.     pic.ForeColor = vbBlack
  333. End Sub
  334.  
  335.  
  336.  
  337. ' ************************************************
  338. ' Shrink fpic into tpic, reducing by a factor of
  339. ' 1/s.
  340. ' ************************************************
  341. Sub ShrinkPicture(fpic As PictureBox, tpic As PictureBox, S As Integer)
  342. Dim x As Integer
  343. Dim y As Integer
  344. Dim i As Integer
  345. Dim j As Integer
  346. Dim r As Long
  347. Dim g As Long
  348. Dim b As Long
  349. Dim newr As Integer
  350. Dim newg As Integer
  351. Dim newb As Integer
  352.  
  353.     For y = 0 To tpic.ScaleHeight - 1
  354.         For x = 0 To tpic.ScaleWidth - 1
  355.             ' Compute the value of pixel (x, y).
  356.             r = 0
  357.             g = 0
  358.             b = 0
  359.             For i = 0 To S - 1
  360.                 For j = 0 To S - 1
  361.                     SeparateColor _
  362.                         fpic.Point(S * x + j, S * y + i), _
  363.                         newr, newg, newb
  364.                     r = r + newr
  365.                     g = g + newg
  366.                     b = b + newb
  367.                 Next j
  368.             Next i
  369.             r = r / S / S
  370.             g = g / S / S
  371.             b = b / S / S
  372.             tpic.PSet (x, y), RGB(r, g, b)
  373.         Next x
  374.         DoEvents
  375.     Next y
  376. End Sub
  377.  
  378. ' ************************************************
  379. ' Break an RGB color into its components.
  380. ' ************************************************
  381. Private Sub SeparateColor(color As Long, r As Integer, g As Integer, b As Integer)
  382.     r = color Mod 256
  383.     g = color \ 256 Mod 256
  384.     b = color \ 256 \ 256
  385. End Sub
  386.  
  387. Private Sub Form_Load()
  388.     ' Make everyone use the same font.
  389.     AntiAliasedPic.Font.Name = AliasedPic.Font.Name
  390.     AntiAliasedPic.Font.Bold = AliasedPic.Font.Bold
  391.     AntiAliasedPic.Font.Italic = AliasedPic.Font.Italic
  392.     AntiAliasedPic.Font.Strikethrough = AliasedPic.Font.Strikethrough
  393.     AntiAliasedPic.Font.Underline = AliasedPic.Font.Underline
  394.  
  395.     EnlargedPic.Font.Name = AliasedPic.Font.Name
  396.     EnlargedPic.Font.Bold = AliasedPic.Font.Bold
  397.     EnlargedPic.Font.Italic = AliasedPic.Font.Italic
  398.     EnlargedPic.Font.Strikethrough = AliasedPic.Font.Strikethrough
  399.     EnlargedPic.Font.Underline = AliasedPic.Font.Underline
  400.         
  401.     ' Make AntiAliasedPic use the right thicknesses.
  402.     AntiAliasedPic.DrawWidth = AliasedPic.DrawWidth
  403.     AntiAliasedPic.Font.Size = AliasedPic.Font.Size
  404.         
  405.     ' Draw original stuff.
  406.     DrawIt AliasedPic
  407. End Sub
  408.  
  409. Private Sub Form_Unload(Cancel As Integer)
  410.     End
  411. End Sub
  412.  
  413.  
  414. Private Sub mnuFileExit_Click()
  415.     Unload Me
  416. End Sub
  417.  
  418.  
  419.